/* GUI CONVERTED from rcswbuf.p (converter v1.76) Wed Jan 30 11:13:11 2002 */
/* rcswbuf.p - SHIPPER WORKBENCH USER FIELD MAINTENANCE                 */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                  */
/* All rights reserved worldwide.  This is an unpublished work.         */
/* $Revision: 1.8 $                                                 */
/*                                                                      */
/* This program updates the user fields that have been defined for the  */
/* shipper.                                                             */
/*                                                                      */
/* Revision: 1.7    BY: Dan Herman   DATE: 07/16/01   ECO: *P006* */
/* $Revision: 1.8 $      BY: Dan Herman    DATE: 01/30/02   ECO: *P046*  */
/*V8:ConvertMode=Maintenance                                            */
/*                                                                           */
/* -----  W A R N I N G  -----  W A R N I N G  -----  W A R N I N G  -----   */
/*                                                                           */
/*         THIS PROGRAM IS A BOLT-ON TO STANDARD PRODUCT MFG/PRO.            */
/* ANY CHANGES TO THIS PROGRAM MUST BE PLACED ON A SEPARATE ECO THAN         */
/* STANDARD PRODUCT CHANGES.  FAILURE TO DO THIS CAUSES THE BOLT-ON CODE TO  */
/* BE COMBINED WITH STANDARD PRODUCT AND RESULTS IN PATCH DELIVERY FAILURES. */
/*                                                                           */
/* -----  W A R N I N G  -----  W A R N I N G  -----  W A R N I N G  -----   */
/*                                                                           */

{mfdeclre.i}
{gplabel.i}

define input parameter ipSpecificField like mfc_logical no-undo.
define input parameter ipFieldName as character no-undo.
define input parameter ipAbsID like abs_id no-undo.
define input parameter ipShipFrom like abs_shipfrom no-undo.

define variable ctr as integer no-undo.
define variable new_sodlc_det like mfc_logical no-undo.
define variable l_is_first like mfc_logical no-undo.
define variable where_we_are as integer no-undo.
define variable absddet_recid as recid.
define variable new_absd_det like mfc_logical no-undo.
define variable last_field as character no-undo.
define variable del-yn like mfc_logical no-undo.
define variable l_msg_nbr as integer no-undo.
define variable prgname as character no-undo.
define variable validation_failed like mfc_logical no-undo.

/*V8:EditableDownFrame=fld_det */
FORM /*GUI*/ 
   absd_fld_seq
   absd_fld_name
   absd_fld_value
with frame fld_det down centered scroll 1 attr-space width 80
title color normal (getFrameTitle("USER_FIELDS",29)) THREE-D /*GUI*/.


/* SET EXTERNAL LABELS */
setFrameLabels(frame fld_det:handle).

view frame fld_det.

fldloop:
do with frame fld_det:
   clear frame fld_det all no-pause.
   view frame fld_det.

   for first absd_det
      fields(absd_abs_id absd_shipfrom absd_abs_fld_name
             absd_fld_seq absd_fld_name absd_fld_value
             absd_fld_prompt absd_validate)
      no-lock
      where
         absd_abs_id    = ipAbsID
      and absd_shipfrom = ipShipFrom
      and absd_abs_fld_name = (if ipSpecificField then
                                   ipFieldName else ""):
   end.

   ctr = 0.

   do while ctr < frame-down and available absd_det:
      display
         absd_fld_seq
         absd_fld_name
         absd_fld_value.

      ctr = ctr + 1.
      if ctr < frame-down then down 1.
      find next absd_det no-lock
         where
             absd_abs_id    = ipAbsID
         and absd_shipfrom = ipShipFrom
         and absd_abs_fld_name = (if ipSpecificField then
                                     ipFieldName else "")
      no-error.
   end. /*DO WHILE CTR <*/

   up frame-line - 1.

   for first absd_det
      fields(absd_abs_id absd_shipfrom absd_abs_fld_name
             absd_fld_seq absd_fld_name absd_fld_value
             absd_fld_prompt absd_validate)
      no-lock
      where
          absd_abs_id    = ipAbsID
      and absd_shipfrom = ipShipFrom
      and absd_abs_fld_name = (if ipSpecificField then
                                  ipFieldName else ""):
   end.

   seqloop:
   repeat with frame fld_det:
/*GUI*/ if global-beam-me-up then undo, leave.

      ststatus = stline[1].
      status input ststatus.
      pause before-hide.

      prompt-for
         absd_fld_seq
      go-on (F9 F10 CURSOR-UP CURSOR-DOWN).

      pause 0.

      if frame-field = "absd_fld_seq" then next-prompt absd_fld_seq.

      do while lastkey = keycode("F9")
          or lastkey = keycode("CURSOR-UP")
          or lastkey = keycode("F10")
          or lastkey = keycode("CURSOR-DOWN")
          on endkey undo, leave seqloop:

         if available absd_det then do:
            if lastkey = keycode("F9")
                or lastkey = keycode("CURSOR-UP")
                then do:

                find prev absd_det
                    where
                        absd_abs_id    = ipAbsID
                    and absd_shipfrom = ipShipFrom
                    and absd_abs_fld_name = (if ipSpecificField then
                                                ipFieldName else "")
                exclusive-lock no-error.
                if available absd_det then do:
                    up 1.
                    display
                        absd_fld_seq
                        absd_fld_name
                        absd_fld_value.
                end.
                else do:
                    for first absd_det
                        where
                            absd_abs_id    = ipAbsID
                        and absd_shipfrom = ipShipFrom
                        and absd_abs_fld_name =
                                         (if ipSpecificField then
                                             ipFieldName else "")
                        exclusive-lock:
                    end.
                    bell.
                end.
            end. /* IF F9 OR CURSOR-UP */

            else if lastkey = keycode("F10")
                or lastkey = keycode("CURSOR-DOWN")
                then do:
                find next absd_det
                    where
                        absd_abs_id    = ipAbsID
                    and absd_shipfrom = ipShipFrom
                    and absd_abs_fld_name = (if ipSpecificField then
                                         ipFieldName else "")
                exclusive-lock no-error.

                if available absd_det then do:
                    down 1.
                    display
                        absd_fld_seq
                        absd_fld_name
                        absd_fld_value.
                end.
                else do:
                    for last absd_det
                        where
                            absd_abs_id    = ipAbsID
                        and absd_shipfrom = ipShipFrom
                        and absd_abs_fld_name =
                                         (if ipSpecificField then
                                             ipFieldName else "")
                        exclusive-lock:
                    end.
                    bell.
                end.
            end. /*ELSE IF LASTKEY = F10*/
         end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /*IF AVAILABLE ABSD_DET*/

         ststatus = stline[1].
         status input ststatus.

         pause before-hide.
         prompt-for absd_fld_seq
            go-on (F9 F10 CURSOR-UP CURSOR-DOWN).
         pause 0.

         if frame-field = "absd_fld_seq" then
            next-prompt absd_fld_seq.
      end. /* DO WHILE LASTKEY = F9*/

      for last absd_det
         where
            absd_abs_id    = ipAbsID
         and absd_shipfrom = ipShipFrom
         and absd_abs_fld_name = (if ipSpecificField then
                                ipFieldName else "")
         and absd_fld_seq = input absd_fld_seq
         exclusive-lock:
      end.

      if input absd_fld_seq < 1 or
         input absd_fld_seq = "" then do:
         /* SEQUENCE NUMBER MUST BE GREATER THAN ZERO */
         {pxmsg.i &MSGNUM=1034 &ERRORLEVEL=3}
         undo, retry seqloop.
      end.

      if not available absd_det then do:
         if can-find(first absd_det where
                absd_abs_id = ipAbsID
            and absd_shipfrom = ipShipFrom
            and absd_fld_seq = input absd_fld_seq)
            then do:
               /* SEQUENCE NUMBER ALREADY EXISTS */
               {pxmsg.i &MSGNUM=8520 &ERRORLEVEL=3}
               undo, retry seqloop.
         end.

         new_absd_det = yes.
         {pxmsg.i &MSGNUM=1 &ERRORLEVEL=1}
          /* ADDING NEW RECORD */
         create absd_det.
         assign
            absd_abs_id = ipAbsID
            absd_shipfrom = ipShipFrom
            absd_abs_fld_name = (if ipSpecificField then
                                    ipFieldName else "")
            absd_fld_prompt = yes
            absd_fld_seq = input absd_fld_seq
            absd_mod_userid = global_userid
            absd_mod_date = today.

         if recid(absd_det) = -1 then.
      end. /* NOT AVAILABLE*/

      else new_absd_det = no.

      assign
         absddet_recid = recid(absd_det)
         where_we_are = frame-line.

      /*SET RECORD POINTER BEFORE FINDING PREV RECORD.*/
      for first absd_det
         where recid(absd_det) = absddet_recid
         exclusive-lock:
      end.
      if new_absd_det and frame-line <> frame-down
         then do:
            do ctr = 1 to frame-down - 1 while available absd_det:
               find prev absd_det
                  where
                     absd_abs_id    = ipAbsID
                  and absd_shipfrom = ipShipFrom
                  and absd_abs_fld_name = (if ipSpecificField then
                                            ipFieldName else "")
               no-lock no-error.

            end. /* DO CTR = 1 TO FRAME-DOWN - 1 */
         if available absd_det
            then do:
            find prev absd_det
               where
                  absd_abs_id    = ipAbsID
               and absd_shipfrom = ipShipFrom
               and absd_abs_fld_name = (if ipSpecificField then
                                            ipFieldName else "")
            no-lock no-error.
        end. /* IF AVAILABLE ABSD_DET */
      end. /*IF NEW_ABSD_DET*/

      else
         do ctr = 1 to where_we_are while available absd_det:
            find prev absd_det
               where
                  absd_abs_id    = ipAbsID
               and absd_shipfrom = ipShipFrom
               and absd_abs_fld_name = (if ipSpecificField then
                                  ipFieldName else "")
            no-lock no-error.
      end.

      /*DETERMINE IF THE TOP MOST RECORD IN THE FRAME IS THE*
       * VERY FIRST ABSD_DET RECORD*/

      if not available absd_det
         then l_is_first = yes.
      else
         l_is_first = no.

      up where_we_are - 1.

      do ctr = 1 to frame-down:
         if ctr = 1 and l_is_first
         then
            for first absd_det
               fields(absd_abs_id absd_shipfrom absd_abs_fld_name
                      absd_fld_seq absd_fld_name absd_fld_value
                      absd_fld_prompt absd_validate)
               where
                  absd_abs_id    = ipAbsID
               and absd_shipfrom = ipShipFrom
               and absd_abs_fld_name = (if ipSpecificField then
                                        ipFieldName else "")
            no-lock:
         end.
         else
            find next absd_det
               where
                  absd_abs_id    = ipAbsID
               and absd_shipfrom = ipShipFrom
               and absd_abs_fld_name = (if ipSpecificField then
                                        ipFieldName else "")
               no-lock no-error.

         if available absd_det then do:
            display
               absd_fld_seq
               absd_fld_name
               absd_fld_value.
            if recid(absd_det) = absddet_recid then
                where_we_are = frame-line.
         end.

         else do:
            display
                "" @ absd_fld_seq
                "" @ absd_fld_name
                "" @ absd_fld_value.
         end.

         if ctr < frame-down then down 1.
      end. /*DO CTR = 1 TO FRAME-DOWN*/

      up frame-down - where_we_are.

      for first absd_det
         where
            recid(absd_det) = absddet_recid
         exclusive-lock:
      end.

      ststatus = stline[2].
      status input ststatus.

      valueloop:
      do on error undo, retry:
/*GUI*/ if global-beam-me-up then undo, leave.

        pause before-hide.

        set
            absd_fld_name when (new_absd_det)
            absd_fld_value when (absd_fld_prompt)
            /*V8+*/

                  go-on(ESC F5 CTRL-D)   
        with frame fld_det editblk: editing:
           {gpbrparm.i
              &browse=cclu002.p
              &parm=c-brparm1
              &val=absd_validate}
            if frame-field <> "" then last_field = frame-field.

            readkey.
            apply lastkey.

            if go-pending or
                (last_field = "absd_fld_name" and
                frame-field <> "absd_fld_name") then do:

                if input absd_fld_name = "" then do:
                    /* BLANK NOT ALLOWED */
                    {pxmsg.i &MSGNUM=40 &ERRORLEVEL=3}
                    next-prompt absd_fld_name with frame fld_det.
                    next editblk.
                end.

                if can-find(first absd_det where
                                absd_abs_id = ipAbsID
                            and absd_shipfrom = ipShipFrom
                            and absd_fld_name = input absd_fld_name
                            and absd_fld_seq <> input absd_fld_seq)
                then do:
                   {pxmsg.i &MSGNUM=4716 &ERRORLEVEL=3}
                    /*FIELD NAME ALREADY EXISTS*/
                    next-prompt absd_fld_name with frame fld_det.
                    next editblk.
                end.

                if go-pending and absd_validate <> ""
                    then do:
                    assign
                        validation_failed = no
                        l_msg_nbr = 0.
                    if substring(absd_validate,
                                 length(absd_validate) - 1, 2) = ".p"
                       then do:
                       {gprun.i ""gprunck.p""
                                "(INPUT absd_validate,
                                  OUTPUT prgname)"}
/*GUI*/ if global-beam-me-up then undo, leave.


                       if prgname <> "" then do:
                          {gprun.i "absd_validate"
                                 "(INPUT recid(absd_det),
                                   INPUT (input absd_fld_value),
                                   OUTPUT validation_failed)"}
/*GUI*/ if global-beam-me-up then undo, leave.

                            /*INVALID APPROVED INPUT */
                          if validation_failed then l_msg_nbr = 504.
                          if false  then do:
                             /* ACCOUNT FOR NON REFERENCED PROGRAMS */
                             {gprun.i ""cctvalid.p""}
/*GUI*/ if global-beam-me-up then undo, leave.

                          end.
                       end.
                       else do:
                          /* Program # not found */
                          {pxmsg.i
                             &MSGNUM = 2060
                             &ERRORLEVEL = 2
                             &MSGARG1 = absd_validate}.
                       end.
                    end.
                    else
                        if not can-find(first code_mstr where
                                 code_fldname = absd_validate
                            and code_value = input absd_fld_value)
                            then l_msg_nbr = 716.
                        /*VALUE MUST EXIST IN GENERALIZED CODES*/

                    if l_msg_nbr <> 0 then do:
                       {pxmsg.i &MSGNUM=l_msg_nbr &ERRORLEVEL=3}
                      next-prompt absd_fld_value with frame fld_det.
                      next editblk.
                    end.

                end. /* IF GO-PENDING AND ABSD_VALIDATE */
            end. /* IF GO-PENDING OR */
        end. /* EDITING */

        if lastkey = keycode("F5") or
            lastkey = keycode("CTRL-D") then do:

            del-yn = yes.

            /* PLEASE CONFIRM DELETE */
            {pxmsg.i &MSGNUM=11 &ERRORLEVEL=1 &CONFIRM=del-yn}
            if del-yn = no then do:
                display
                    absd_fld_seq
                    absd_fld_name
                    absd_fld_value.
                next. /* editblk.*/
            end.

            for first absd_det
                where
                    absd_abs_id = ipAbsID
                and absd_shipfrom = ipShipFrom
                and absd_fld_seq = input absd_fld_seq
                exclusive-lock:
            end.

            delete absd_det.

            where_we_are = frame-line.

            find next absd_det
                where
                    absd_abs_id    = ipAbsID
                and absd_shipfrom = ipShipFrom
                and absd_abs_fld_name = (if ipSpecificField then
                                            ipFieldName else "")
                no-lock no-error.
            if available absd_det then do:
                absddet_recid = recid(absd_det).

                display
                    absd_fld_seq
                    absd_fld_name
                    absd_fld_value.


                do ctr = where_we_are to frame-down - 1:
                    down 1.

                    find next absd_det
                        where
                            absd_abs_id    = ipAbsID
                        and absd_shipfrom = ipShipFrom
                        and absd_abs_fld_name =
                                            (if ipSpecificField then
                                                ipFieldName else "")
                        no-lock no-error.

                    if available absd_det then
                        display
                            absd_fld_seq
                            absd_fld_name
                            absd_fld_value.
                    else
                        display
                            "" @ absd_fld_seq
                            "" @ absd_fld_name
                            "" @ absd_fld_value.
                end. /* DO CTR = WHERE_WE_ARE TO */

                up frame-down - where_we_are.

                for first absd_det
                    where
                        recid(absd_det) = absddet_recid
                    exclusive-lock:
                end.
            end. /* IF AVAILABLE ABSD_DET */

            else do:
                display
                    "" @ absd_fld_seq
                    "" @ absd_fld_name
                    "" @ absd_fld_value.

                find prev absd_det
                    where
                        absd_abs_id    = ipAbsID
                    and absd_shipfrom = ipShipFrom
                    and absd_abs_fld_name = (if ipSpecificField then
                                                ipFieldName else "")
                    exclusive-lock no-error.
                if available absd_det then do:
                    up 1.
                    display
                        absd_fld_seq
                        absd_fld_name
                        absd_fld_value.
                end.
            end. /*ELSE DO*/
        end. /* IF LASTKEY = F5 */

        else
            if keyfunction(lastkey) = "END-ERROR":U then
                display
                    absd_fld_seq
                    absd_fld_name
                    absd_fld_value.
        else do:
            assign
                absd_fld_name
                absd_fld_value.

            if new_absd_det and frame-line <> frame-down then do:
                assign
                    where_we_are = frame-line
                    absddet_recid = recid(absd_det).

                do ctr = 1 to where_we_are + 1
                    while available absd_det:

                    find prev absd_det
                        where
                            absd_abs_id    = ipAbsID
                        and absd_shipfrom = ipShipFrom
                        and absd_abs_fld_name =
                                        (if ipSpecificField then
                                                ipFieldName else "")
                    no-lock no-error.

                end.

                up where_we_are - 1.

                /* DETERMINE IF THE TOP MOST RECORD IN THE FRAME*
                 * IS THE VERY FIRST ABSD_DET RECORD */

                if not available absd_det then l_is_first = yes.
                else l_is_first = no.

                do ctr = 1 to frame-down:
                    if ctr = 1 and l_is_first then
                        for first absd_det
                           fields(absd_abs_id absd_shipfrom absd_abs_fld_name
                                  absd_fld_seq absd_fld_name absd_fld_value
                                  absd_fld_prompt absd_validate)
                            where
                                absd_abs_id    = ipAbsID
                            and absd_shipfrom = ipShipFrom
                            and absd_abs_fld_name = (if ipSpecificField then
                                                     ipFieldName else "")
                        no-lock:
                    end. /* IF CTR = 1 */

                    else
                        find next absd_det
                            where
                                absd_abs_id    = ipAbsID
                            and absd_shipfrom = ipShipFrom
                            and absd_abs_fld_name =
                                (if ipSpecificField then
                                                ipFieldName else "")
                        no-lock no-error.

                    if available absd_det then do:
                        display
                            absd_fld_seq
                            absd_fld_name
                            absd_fld_value.
                        if recid(absd_det) = absddet_recid then
                            where_we_are = frame-line.
                    end. /*IF AVAILABLE ABSD_DET */

                    else
                        display
                            "" @ absd_fld_seq
                            "" @ absd_fld_name
                            "" @ absd_fld_value.
                    if ctr < frame-down then down 1.

                end. /* DO CTR = 1 TO FRAME-DOWN */

                up frame-down - where_we_are.
                for first absd_det
                    where
                        absd_abs_id    = ipAbsID
                    and absd_shipfrom = ipShipFrom
                    and absd_abs_fld_name = (if ipSpecificField then
                                                ipFieldName else "")
                    exclusive-lock:
                end.

                absddet_recid = recid(absd_det).

            end. /* IF NEW_ABSD_DET */
        end. /* ELSE DO */
      end. /* VALUELOOP */
   end. /* SEQLOOP */
end. /* FLDLOOP */
hide frame fld_det.
